home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / GNU-TILE-FORTH.lha / tst / bubble-sort.tst < prev    next >
Text File  |  1992-05-19  |  1KB  |  64 lines
  1. .( Loading Bubble Sort benchmark...) cr
  2.  
  3. \ A classical benchmark of an O(n**2) algorithm; Bubble sort
  4. \
  5. \ Part of the programs gathered by John Hennessy for the MIPS
  6. \ RISC project at Stanford. Translated to forth by Marty Fraeman
  7. \ Johns Hopkins University/Applied Physics Laboratory.
  8.  
  9. variable seed ( -- addr)
  10.  
  11. : initiate-seed ( -- )  74755 seed ! ;
  12. : random  ( -- n )  seed @ 1309 * 13849 + 65535 and dup seed ! ;
  13.  
  14. 500 constant elements ( -- int)
  15.  
  16. align create list elements cells allot
  17.  
  18. : initiate-list ( -- )
  19.   list elements cells + list do random i ! cell +loop
  20. ;
  21.  
  22. : dump-list ( -- )
  23.   list elements cells + list do i @ . cell +loop cr
  24. ;
  25.  
  26. : verify-list ( -- )
  27.   list elements 1- cells bounds do
  28.     i 2@ > abort" bubble-sort: not sorted"
  29.   cell +loop
  30. ;
  31.  
  32. : bubble ( -- )
  33.   1 elements 1 do
  34.     list elements i - cells bounds do
  35.       i 2@ > if i 2@ swap i 2! then
  36.     cell +loop 
  37.   loop
  38. ;
  39.  
  40. : bubble-sort ( -- )
  41.   initiate-seed
  42.   initiate-list
  43.   bubble
  44.   verify-list
  45. ;
  46.  
  47. : bubble-with-flag ( -- )
  48.   1 elements 1 do
  49.     true list elements i - cells bounds do
  50.       i 2@ > if i 2@ swap i 2! drop false then
  51.     cell +loop 
  52.     if leave then
  53.   loop
  54. ;
  55.   
  56. : bubble-sort-with-flag ( -- )
  57.   initiate-seed
  58.   initiate-list
  59.   bubble-with-flag
  60.   verify-list
  61. ;
  62.  
  63. forth only
  64.